#Logtrack-ng: Module for analyzing and parsing message
#Copyright (C) 2007 Jan Kucera
#
#This program is free software; you can redistribute it and/or
#modify it under the terms of the GNU General Public License
#as published by the Free Software Foundation; either version 2
#of the License, or (at your option) any later version.
#
#This program is distributed in the hope that it will be useful,
#but WITHOUT ANY WARRANTY; without even the implied warranty of
#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#GNU General Public License for more details.
#
#You should have received a copy of the GNU General Public License
#along with this program; if not, write to the Free Software
#Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.

=head1 NAME

Logtrack::Analyzer;

=head1 DESCRIPTION

Modul se stara o analyzu a rozparsovani dane zpravy na jednotlive casti podle
konfigurace. Zprava je nejprve kontrolovana pres filtr - pokud neprojde, je
ze zpravy zjisten klic pro identifikace v services (pokud je to vyzadovano 
nastavenim) a udaj vlozen do DB. Pokud projde, je zprava kontrolovana na 
vyjimky z formatu logu, odtud je teprve rozlozena na jednolive casti, ktere
se pak podle kriterii porovnavaji se seznamem akci - pokud udaje odpovidaji,
je z konfigurace nacte modul a spustena zvolena externi funkce modulu.

=head2 FUNCTIONS
=over 4

=item analyse
=item parse
=item parse_msg
=item filter_msg
=item filter_part
=item log_in_services
=item exception_in_msg
=item string_check
=item time_check
=item hostname_check
=item actions

=cut
package Logtrack::Analyzer;

use strict;
no strict 'refs';
no strict 'subs';

use Exporter;
use Logtrack::DBI;
use Logtrack::Debug;
use Data::Dumper;
use Regexp::Common qw(time);
use Net::DNS;
use XML::Dumper;
use Date::Manip;
use DBI;
$Data::Dumper::Indent = 1;

use constant TRUE => 1;
use constant FALSE => 0;

# our @ISA = qw(Logtrack::DBI);

sub new {
	my ($self) = @_;
	
# 	my $analyzer = $self->SUPER::new();
	my $analyzer = {};
	my $class = ref $self || $self;	
	$analyzer->{debug} = Logtrack::Debug->new();
	bless ($analyzer, $class);
	$analyzer->debugln('Building module Analyzer.. complete!',3);		
	return $analyzer;
}

sub errstr {
	my ($self,$message) = @_;
	$self->{debug}->errstr($message);
}

sub errstrln {
	my ($self,$message) = @_;
	$self->{debug}->errstrln($message);
}

sub log_in {
	my ($self,$message) = @_;
	$self->{debug}->log_in($message);
}

sub debug {
	my ($self,$message,$level) = @_;
	$self->{debug}->debug($message,$level);
}

sub debugln {
	my ($self,$message,$level) = @_;
	$self->{debug}->debugln($message,$level);
}

sub println {
	my ($self,$message,$level) = @_;
	$self->{debug}->println($message,$level);
}

=item
Analyse postupne vola jednotlive dalsi funkce, v pripade, ze nevratily 
zaporny vysledek.
=cut

sub analyse {
	my ($self,$ref_line,$ref_log) = @_;
	
	return if( $self->exception_in_msg($ref_line,$ref_log));
	$self->debugln('No exception found.',3);
	return if( $self->filter_msg($ref_line,$ref_log) );
	$self->debugln('No filter found.',3);
	my $ref_message = $self->parse($$ref_line,$ref_log);
	$self->debugln('Parsing complete.',3);
	return if ($ref_message == 0);
	if($ref_message == 0) {
		$self->debugln('Reference message is empty!',3);
		return;
	}
	
	$self->actions($ref_message,$ref_line,$ref_log);
	return;
}

=item 
Funkce postupne vola funkci parse_msg tolikrat, na kolik casti je podle 
konfigurace rozdelena zprava. Funkce je zde pro samotnou analyzu, pokud 
projde testy - zavedeno z duvodu vyuziti funkce ve funkci log_in_services
=cut

sub parse($$) {
	my ($self,$line,$ref_cfg) = @_; #Vlozi se odkaz na zpravu
	my $logtype = \$$ref_cfg->{logtype}; #Alias pro zkraceni kodu
	my %message;
	
	$self->debug("\n",1); #Odsazeni zprav pro lepsi prehlednost

	#Rozdeleni zpravy na jeji podcasti a ulozeni do %message
	for(my $index = 0; $index < @{$$logtype}; $index++) {
		if(not $self->parse_msg(
			\$line,\$$logtype->[$index],\%message,$ref_cfg) ) {
			return FALSE;
		}
	}
	$self->debug('-' x 15 ."\n",1);
	return \%message;
}

=item 
Funkce nejprve zjisti o jaky druh udaje jde a podle toho zavola prislusnou 
funkci, ktera se postara o parsovani daneho useku zpravy
=cut

sub parse_msg {
	my ($self,$ref_line,$ref_logtype,$ref_message,$ref_cfg) = @_;

	if( ($$ref_logtype->{type} eq 'timestamp') ) {
		if( $self->time_check($ref_line,$ref_logtype,$ref_message) ) {
			return TRUE;
		}
	}
	elsif( ($$ref_logtype->{type} eq 'string') ) { 
		if( $self->string_check($ref_line,$ref_logtype,
					$ref_message,\$$ref_cfg->{local_filters}) ) {
			return TRUE;
		}
	}
	elsif( ($$ref_logtype->{type} eq 'hostname') ) {
		if( $self->hostname_check($ref_line,$ref_logtype,
					$ref_message,\$$ref_cfg->{local_filters}) ) {
			return TRUE;
		}
	}
	return FALSE;
}

=item 
Funkce testuje zpravu na shodu s RE, vyhodnocovani zavisi na nastaveni param.
"First", ktery urcuje zda filtr zahazuje zpravy, ktere se shoduji nebo pouze 
shodne akceptuje. Pokud se funkce zahazuje musi byt jeste zavolana fce 
log_in_services (pokud to vyzaduje konfigurace, ktera zanese zaznam o posledni
zprave.

=cut
sub filter_msg($$) {
	my ($self,$ref_line,$ref_config) = @_;
	my $ref_filters = \$$ref_config->{global_filters};
	my $skip = undef;
	if(defined $$ref_filters->{regexp}) {
		foreach my $filter (@{$$ref_filters->{regexp}}) {
			if($$ref_line =~ /$filter/) {
				if($$ref_filters->{first} eq 'Drop') {
					$skip = TRUE;
					last;
				}
				else {
					$skip = FALSE;
					last;
				}
			}
		}
		
		if(not defined $skip) {
		$skip = TRUE if $$ref_filters->{first} eq 'Accept';
		return FALSE if $$ref_filters->{first} eq 'Drop';
		}
	}
	else {
		return FALSE;
	}
	$self->log_in_services($ref_line,$ref_config) 
		if($skip && defined $$ref_config->{keys});
	return $skip;
}

=item
Funkce se stara o filtrovani na lokalni (v ramci casti zpravy) urovni.
Narozdil od filter_msg vraci opacne hodnoty a vola log_in_services s odkazem
na hash message, ktery obsahuje uz rozparsovane casti.
=cut 
sub filter_part {
	my ($self,$ref_line,$ref_message,$ref_logtype,$ref_local_filters) = @_;
	my ($skip,$part,$index,$section);
	($index,$section) = split(/\./, $$ref_logtype->{id},2);
	
	my $ref_config = \$self->{data}{logs}->[$index];
	
	$part = $ref_message->{ $$ref_logtype->{name} };
	
	foreach my $filter (@{$$ref_local_filters}) {
		next if($filter->{name} ne $$ref_logtype->{name});
			
		for(my $index=0; $index < @{$filter->{regexp}};$index++) {
			if($part =~ /$filter->{regexp}->[$index]/) {
				if($filter->{first} eq 'Drop') {
					$skip = FALSE; #Zprava se filtruje
					last;
				} 
				else { #$part je obsazena v Accept
					return TRUE;
				} 
			}
		}
		
		if(not defined $skip) {
			$skip = FALSE if($filter->{first} eq 'Accept');
			last;
			return TRUE if($filter->{first} eq 'Drop');
		}
	}
	
	if(not defined $skip) {
		return TRUE;
	}
	$self->log_in_services($ref_line,$ref_config,$ref_message) 
		if(not $skip && defined $$ref_config->{keys});
	return $skip;
}

=item
Funkce nacte z konfigurace nastaveni identifikujicich klicu pro zapis do
tabulky services. Podle klice pak parsuje zpravu az do casti obsahujici 
nejvetsi klic (setreni vykonu, nebot tyto zpravy nejsou, s vyjimkou udaje 
v services dulezite pro chod programu) a zapise udaj do DB. Funkce rovnez muze 
dostat jako svuj posledni parametr odkaz na hash messages, tu pripadne doplni
o nezbytne klice pro zapis do services.
=cut

sub log_in_services {
	my ($self,$ref_line,$ref_config,$ref_message) = @_;
	my ($service_key,@array);

	if(not defined $ref_message) {
		my %message;
		$ref_message = \%message;
	}

	my @keys = split /\|/ , $$ref_config->{keys};
	my $max_key = $keys[ @keys - 1 ];
	my $ref_logtype = \$$ref_config->{logtype};

	my $index = scalar(keys %{$ref_message});
	
	for( ; $index <= $max_key; $index++) {
		return if (not $self->parse_msg(
			$ref_line,\$$ref_logtype->[$index],$ref_message) );
	}
	
	foreach my $key (@keys) {
		$array[$key] = $$ref_message{$$ref_config->{logtype}->[$key]->{name}};
	}

	if(@array) {
		foreach my $prvek (@array) {
			next if(not $prvek);
			if($service_key) {
				$service_key .= '|' . $prvek;
			}
			else {
				if($$ref_config->{file} ne '') {
					$service_key = $$ref_config->{file} .': '. $prvek;
				}
				else {
					$service_key = $$ref_config->{socket}->{proto} .' '.
						$$ref_config->{socket}->{port} .': '. $prvek;
				}
			}
		}
		$self->insert_service($service_key);
	}
	return;
}

=item
Funkce kontroluje zpravu na vyskyt vyjimky, ktera by neprosla parsovanim, nebot
neodpovida formatu zpravy. Nad touto zpravou je pak spustena funkce z externiho
modulu.
=cut

sub exception_in_msg($$) {
	my ($self,$ref_line,$ref_config) = @_;
	my $ref_exceptions = \$$ref_config->{exceptions};
	my $ref_db = $self->{dbi}->get_db();
	if(not defined $ref_db) {
		$self->errstrln('Database is not defined!');
		exit(1);
	}
	my $except = FALSE;
	
	return $except if($$ref_exceptions eq '');
	
	foreach my $exception ( @{$$ref_exceptions} ) {
		if($$ref_line =~ /$exception->{re}/) {
			eval "$exception->{run}";
			if($@) { 
				$self->errstr($@);
			}
			return TRUE;
		}
	}
return $except;
}

=item
Funkce vytahne cas ze zpravy a o tento udaj zpravu orizne.Ziskany vysledek
pak ulozi do hashe messages pod klicem jmena dane casti. Pokud funce
neziska cas vraci FALSE, ktery zamezi dalsimu zpracovani zpravy.
Viz info:
http://search.cpan.org/~roode/Regexp-Common-time-0.01/time.pm
http://search.cpan.org/~roode/Time-Format-1.02/Format.pm
=cut

sub time_check($$$) {
	my ($self,$ref_line, $ref_logtype,$ref_message) = @_;
	my $all;
	
	#Porovnani formatu - pokud se shoduje - je cas ulozen do prom. $all
	if( ($all) = $$ref_line =~ 
		$RE{time}{tf}{-pat => $$ref_logtype->{format} }{-keep}) {
		$$ref_line =~ s/$all//; #Cas je odstranen ze zpravy
		$self->debugln($$ref_logtype->{name} .': '. $all,1);

		$ref_message->{$$ref_logtype->{"name"}} = $all;
		return TRUE;
	}
	else {#Neuspech na shodu s casovymi znackami
		$self->errstr('Time parsing failure :'. "\n$$ref_line\n");
		$self->errstr('Original message was:'."\n $self->{line}");
		return FALSE;
	}
}

=item
Funkce extrahuje ze zpravy retezec odpovidajici zadenemu RE.
Funguje na stejnem principu jako time_check.
=cut

sub string_check {
	my ($self,$ref_line, $ref_logtype,$ref_message,$ref_local_filters) = @_;
	my ($skip,$part_of_msg) = '';
	
	if($$ref_line eq '') {
		$self->errstr('String_check works with empty string'."\n");
		return FALSE;
	}
	
	if($$ref_line =~ /($$ref_logtype->{format})/ ) {
		#Do ref_lines je zaveden jen $POSTMATCH - co nevyhovovalo retezci
		$part_of_msg = $2;
		$$ref_line = $';
	}
	else {
		$self->errstr('Can\'t extract string - wrong regular expression' ."\n");
		$self->errstr('Original message was:'."\n $self->{line}");
		return FALSE;
	}

	$ref_message->{$$ref_logtype->{name}}= $part_of_msg;
	$self->debugln($$ref_logtype->{name} .': '. $part_of_msg,1);
	
	return TRUE if(not defined $$ref_local_filters);
	
	if(@{$$ref_local_filters}) {
		return $self->filter_part
			($ref_line,$ref_message,$ref_logtype,$ref_local_filters);
	}
	else {
		return TRUE;
	}
}
=item
Function match through regular expression IP address or hostname. This variable
then checks with Net::DNS module and sets as hostname IP address for easier 
firewall blocking.
=cut

=item
Funkce ziska podle RE ip adresu, prip. hostname. Tento udaj pak proveri pres
DNS a prevede jej na IP adresu pro snadnejsi blokovani na FW
=cut

sub hostname_check {
	my ($self,$ref_line, $ref_logtype,$ref_message,$ref_local_filters) = @_;
	my ($hostname,$resolver,$result);
	
	if($$ref_line eq '') {
		$self->errstr('Hostname_check works with empty string'."\n");
		return FALSE;
	}
	
	if($$ref_line =~ /($$ref_logtype->{format})/ ) {
		#Do ref_lines je zaveden jen $POSTMATCH - to co nevyhovovalo retezci
		$hostname = $2;
		$$ref_line = $';
	}
	else {
		$self->errstr('Hostname identification failed'."\n");
		$self->errstr('Original message was:'."\n $self->{line}");
		return FALSE;
	}
	
	#Record of IP is already in memory
	if(exists $self->{dns}->{$hostname}) {
		$hostname = $self->{dns}->{$hostname};
	}
	else {			#hostname is already IP address
		if(not $hostname =~ /^\s*((\d{1,3}\.){3}\d{1,3})\s*$/) {		
			my $resolver = Net::DNS::Resolver->new;
			my $result = $resolver->search($hostname);
		
			if( defined $result ) {
				foreach my $record ($result->answer) {
					if($record->type eq 'A') {
						$hostname = $record->address;
						last;
					}
				}
			}
		}
	}
	
	$$ref_message{ ($$ref_logtype->{name}) } = $hostname;
	$self->debugln( $$ref_logtype->{name} .': '. $hostname,1);

	return TRUE if(not defined $$ref_local_filters);
	
	if(@{$$ref_local_filters}) {
		return $self->filter_part
			($ref_line,$ref_message,$ref_logtype,$ref_local_filters);
	}
	else {
		return TRUE;
	}
	
	return TRUE;
}

=item
Funkce nejprve zapise udaj do services a nasledne zjistuje zda parsovana zprava
neodpovida nejake specificke akci v konfiguraci, pokud ano, vlozi do tabulky 
events udaj o zprave a ziskane ID vlozi do tabulky services. Nasledne zavede 
externi modul a spusti zvolenou funkci. Pokud zadna akce neodpovida, analyza
konci a ziskane udaje jsou zahozeny.
=cut

sub actions {
	my ($self,$ref_message,$ref_orig_msg,$ref_config) = @_;
	my (@array,$service_key,$result,@match);
	my $ref_db = $self->{dbi}->get_db();
	if(not defined $ref_db) {
		$self->errstrln('Database is not defined!');
		exit(1);
	}
	if(defined $$ref_config->{keys}) {
		my @keys = split /\|/ , $$ref_config->{keys};
		foreach my $key (@keys) {
			$array[$key] = 
				$ref_message->{$$ref_config->{logtype}->[$key]->{name}};
		}

		if(@array) {
			foreach my $prvek (@array) {
				next if(not $prvek);
				if($service_key) {
					$service_key .= '|' . $prvek;
				}
				else {
					if($$ref_config->{file} ne '') {
						$service_key = $$ref_config->{file} .': '. $prvek;
					}
					else {
						$service_key = $$ref_config->{socket}->{proto} .' '.
							$$ref_config->{socket}->{port} .': '. $prvek;
					}
				}
			}
			return if( not $self->{dbi}->insert_service($service_key) );
		}
	}
	else {
		$self->debugln('Config keys are not defined');
	}

	foreach my $actions (@{$$ref_config->{actions}}) {
		next if(not $ref_message->{ $actions->{type} } =~ /$actions->{value}/);
		foreach my $condition (@{$actions->{action}}) {
			next if(not @match = $ref_message->{$condition->{format}->{type}}
					=~ /$condition->{format}->{text}/g);

			my $id = $$ref_config->{id};
			if(time >= $$ref_config->{last_erase} + $$ref_config->{duration}) {
				$self->{dbi}->erase_old($id,$$ref_config->{rotate_time});
			}
			
			my $dump = new XML::Dumper;
			my $xml = $dump->pl2xml( $ref_message );

			my $id_event = $self->{dbi}->insert_event($id,$ref_orig_msg,\$xml);
			
			return if(not defined $id_event);

			if(defined $$ref_config->{keys}) {
				$self->{dbi}->insert_service($service_key,$id_event);
			}
			
			#Spousti navolenou funkci nadefinovanou v actions
			eval "$condition->{run}";
			if($@) {
				$self->debug($@);
				$self->errstr($@);
				$$ref_db->rollback;
				return;
			}

			$$ref_db->commit;
			return;
		}
	}
}

1;
